Shareware Grab Bag/Shareware Grab Bag.iso/007/turbo_tk.arc/KEYTTT.PAS

Pascal/Delphi Source File | 1988-02-01 | 6KB | 251 lines

{$S-,R-,V-,D-,T-}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
{         TechnoJocks Turbo Toolkit v4.00            Released: Feb 1, 1987    }
{                                                                             }
{         Module: KeyTTT    --    keyboard and mouse input                    }
{                                                                             }
{                       Copyright R. D. Ainsbury (c) 1986                     }
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}

unit KeyTTT;

Interface

uses CRT, DOS;

type
  Button = (NoB,LeftB,RightB,BothB);

var
  Moused : boolean;
  Horiz_Sensitivity : integer;


Function  Mouse_Installed:Boolean;
Procedure Show_Mouse_Cursor;
Procedure Hide_Mouse_Cursor;
Procedure Get_Mouse_Action(var But: button; var Hor,Ver: integer);
Procedure Move_Mouse(Hor,Ver: integer);
Procedure Confine_Mouse_Horiz(Left,Right:integer);
Procedure Confine_Mouse_Vert(Top,Bot:integer);
Procedure Set_Mouse_Cursor_Style(OrdChar: integer);
Function  GetKey : Char;
Procedure DelayKey(Time : integer);

Implementation

Function Mouse_Installed:Boolean;
var
  Reg: registers;
begin
    Reg.Ax := 0;
    Intr($33,Reg);
    Mouse_Installed :=  Reg.Ax <> 0;
end; {Func Mouse_Installed}

Procedure Show_Mouse_Cursor;
var
  Reg: registers;
begin
    Reg.Ax := 1;
    Intr($33,Reg);
end; {Proc Show_Mouse_Cursor}

Procedure Hide_Mouse_Cursor;
var
  Reg : registers;
begin
    Reg.Ax := 2;
    Intr($33,Reg);
end; {Proc Hide_Mouse_Cursor}

Procedure Get_Mouse_Action(var But: button; var Hor,Ver: integer);
var
  Reg: registers;
begin
    with Reg do
    begin
        Ax := 3;
        Intr($33,Reg);
        Hor := Cx div 8;
        Ver := Dx div 8;
        {$B+}
        If ((Bx and $1) <> $1)  and  ((Bx and $2) <> $2) then
        begin
            But := NoB;
            exit;
        end;
        If ((Bx and $1) = $1)  and   ((Bx and $2) = $2) then
           But := BothB
        else
        begin
            If (Bx and $1) = $1 then
               But := LeftB
            else
               But := RightB;
        end;
        {$B-}
    end; {with}
end;   {Get_Mouse_Action}

Procedure Move_Mouse(Hor,Ver: integer);
var
  Reg: registers;
begin
    Reg.Ax := 4;
    Reg.Cx := pred(Hor*8);
    Reg.Dx := pred(ver*8);
    Intr($33,Reg);
end; {Proc Move_mouse}

Procedure Confine_Mouse_Horiz(Left,Right:integer);
var
 Reg: registers;
begin
    Reg.Ax := 7;
    Reg.Cx := pred(Left*8);
    Reg.Dx := pred(Right*8);
    Intr($33,Reg);
end;

Procedure Confine_Mouse_Vert(Top,Bot:integer);
var
 Reg: registers;
begin
    Reg.Ax := 8;
    Reg.Cx := pred(Top*8);
    Reg.Dx := pred(Bot*8);
    Intr($33,Reg);
end;

Procedure Set_Mouse_Cursor_Style(OrdChar: integer);
var
  Reg: registers;
begin
   Reg.Ax := 10;
   Reg.Bx := 0;        {software text cursor}
   Reg.Cx := $7700;
   Reg.Dx := $77 and OrdChar;
   Intr($33,Reg);
end;

Function GetKey:char;
{waits for keypress or mouse activity}
{Note that if an extended key is pressed e.g. F1, then a value of 128 is
 added to the Char value. Also if a mouse is active the trapped mouse
 activity is returned as follows:

               MouseUp    =  #128;
               MouseDown  =  #129;
               MouseLeft  =  #130;
               MouseRight =  #131;
               MouseEsc   =  #132;        right button
               MouseEnter =  #133;        left button
}
Const
 H = 40;
 V = 13;
 MouseUp    =  #128;
 MouseDown  =  #129;
 MouseLeft  =  #130;
 MouseRight =  #131;
 MouseEsc   =  #132;
 MouseEnter =  #133;
var
  Action,
  Finished : boolean;
  Hor, Ver : integer;
  B : button;
  Ch : char;
begin
    Finished := false;
    Action := false;
    B := NoB;
    If Moused then Move_Mouse(H,V);     {logically put mouse in middle of screen}
    Repeat                      {keep checking Mouse for activity until keypressed}
         If Moused then
         begin
             Get_Mouse_Action(B,Hor,Ver);
             Case B of
             LeftB : begin
                         Ch := MouseEnter;
                         Finished := true;
                     end;
             RightB: begin
                         Ch := MouseEsc;
                         Finished := true;
                     end;
             end; {case}
             If (Ver - V) > 1 then
             begin
                 Ch := MouseDown;
                 Finished := true;
             end
             else
                If (V - Ver) > 1 then
                begin
                    Ch := MouseUp;
                    Finished := true;
                end
                else
                   If (Hor - H) > Horiz_Sensitivity then
                   begin
                       Ch := MouseRight;
                       Finished := true;
                   end
                   else
                      If (H - Hor) > Horiz_Sensitivity then
                      begin
                          Ch := MouseLeft;
                          Finished := true;
                      end;
         end;
         If Keypressed or finished then Action := true;
    until Action;
    If not finished then
    begin
        Ch := ReadKey;
        Repeat
             if Ch = #0 then
             begin
                 Ch := ReadKey;
                 if Ord(Ch) > 127 then
                    Ch := #0
                 else
                    Ch := Chr(Ord(Ch) + 128);
             end;
        Until Ch <> #0;
    end;

    If finished and (Ch in [MouseEnter,MouseEsc]) then
    begin
        Delay(150);
        Get_Mouse_Action(B,Hor,Ver);  {abbbsorb an mouse activity}
    end;
    GetKey := Ch;
end;

Procedure DelayKey(Time : integer);
var
  I : Integer;
  ChD : char;
begin
    I := 1;
    While I < Time DIV 100 do
    begin
        Delay(100);
        I := succ(I);
        If Keypressed then
        begin
            I := MaxInt;
            ChD := GetKey;           {absorb the keypress}
        end;
    end;
end; {DelayKey}

begin   {unit initialization code}
    Moused := Mouse_Installed;
    If Moused then Horiz_Sensitivity := 1;
end.